home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / forth / amiga / amigaker.arc / 18.init < prev    next >
Text File  |  1987-12-30  |  8KB  |  202 lines
  1. ;
  2. ;  18.init
  3. ;
  4. ;
  5. ;
  6.  
  7.  
  8. * Window          (s -- 'window ) Variable holds the window after it is
  9. ; opened.
  10.                   dc.l     -1
  11.                   dc.l     link3
  12. link3             set      *-4
  13.                   dc.b     $86,'Windo',$80!'w'
  14.                   cnop     0,2
  15. _Window           dc.l     docreate
  16.                   dc.l     0
  17.  
  18. * run             (s -- ) Allows multiline colon compilation.
  19.                   dc.w     0
  20.                   dc.l     link2
  21. link2             set      *-4
  22.                   dc.b     $83,'ru',$80!'n'
  23.                   cnop     0,2
  24. _run              dc.l     nest
  25.                   dc.l     _state,_fetch,_question_branch,1$
  26.                   dc.l     _right_bracket,_state,_fetch,_not
  27.                   dc.l       _question_branch,3$
  28.                   dc.l       _interpret
  29. 3$                dc.l     _branch,2$
  30. 1$                dc.l     _interpret
  31. 2$                dc.l     _exit
  32.  
  33. * quit            (s -- )  The main loop. Gets input from the terminal and
  34. ; interprets it.
  35.                   dc.w     -1
  36.                   dc.l     link1
  37. link1             set      *-4
  38.                   dc.b     $84,'qui',$80!'t'
  39.                   cnop     0,2
  40. _quit             dc.l     nest
  41.                   dc.l     _nest_lit,tibbuffer,_tick_tib,_store
  42.                   dc.l     _loading,_off
  43.                   dc.l     _left_bracket
  44. 1$                dc.l     _rp0,_fetch,_rp_store,_status
  45.                   dc.l     _query,_run,_state,_fetch,_not
  46.                   dc.l     _question_branch,2$
  47.                   dc.l     _nest_dot_quote
  48.                   dc.b     4,' ok',0
  49.                   cnop     0,2
  50. 2$                dc.l     _branch,1$
  51.                   dc.l     _exit
  52.  
  53. * warm            (s -- )  Warm start routine.
  54.                   dc.w     -1
  55.                   dc.l     link3
  56. link3             set      *-4
  57.                   dc.b     $84,'war',$80!'m'
  58.                   cnop     0,2
  59. _warm             dc.l     nest
  60.                   dc.l     _true,_nest_abort_quote
  61.                   dc.b     11,'Warm Start',0
  62.                   cnop     0,2
  63.                   dc.l     _exit
  64.  
  65.  
  66. * cold            (s -- )  Cold start routine, first calls boot and if it
  67. ; was succesfull will continue and start the forth quit loop.
  68.                   dc.w     -1
  69.                   dc.l     link3
  70. link3             set      *-4
  71.                   dc.b     $84,'col',$80!'d'
  72.                   cnop     0,2
  73. _cold             dc.l     nest
  74.                   dc.l     _boot,_question_branch,1$
  75.                   dc.l       _setdic,_interpret
  76.                   dc.l       _quit
  77. 1$                dc.l       _nest_lit,100,_nest_bye
  78.                   dc.l     _exit
  79.  
  80. * boot            Deferred word, normally start.
  81.                   dc.w     -1
  82.                   dc.l     link2
  83. link2             set      *-4
  84.                   dc.b     $84,'boo',$80!'t'
  85.                   cnop     0,2
  86. _boot             dc.l     dodefer,_start
  87.  
  88. * start           (s -- fl | t=ok. ) Default for boot.
  89. ; opens intuition, opens a window and opens a console device.
  90. ; If any problem the routine returns false.
  91. ; the window is defined at 'here_window', see forth.asm.
  92.                   dc.w     -1
  93.                   dc.l     link3
  94. link3             set      *-4
  95.                   dc.b     $85,'star',$80!'t'
  96.                   cnop     0,2
  97. _start            dc.l     nest
  98.                   dc.l     _Open_Dos
  99.                   dc.l     _Open_Intuition
  100.                   dc.l     _question_branch,1$
  101.                   dc.l       _nest_lit,here_window,_OpenWindow,_branch,2$
  102. 1$                dc.l       _0,_exit
  103. 2$                dc.l     _dup,_question_branch,3$
  104.                   dc.l       _dup,_Window,_store,_OpenConsole,_branch,4$
  105. 3$                dc.l       _Close_Intuition,_0,_exit
  106. 4$                dc.l     _not,_question_branch,5$
  107.                   dc.l       _Window,_fetch,_CloseWindow,_Close_Intuition
  108.                   dc.l               _0,_exit
  109. 5$                dc.l     _true
  110.                   dc.l     _exit
  111.  
  112.  
  113. * setdic          This is a special routine, it puts the remainder of the
  114. ; command line in the terminal input buffer tib, and sets #tib.
  115. ; It then checks to see if the first word is a number and uses this number
  116. ; (in hex) as the size of the dictionary, and allocates a dictionary.
  117. ; This routine doesn't have a header; it's not visible.
  118. _setdic           dc.l     nest
  119.                   dc.l     _sp0,_fetch,_dup,_4_plus,_fetch,_swap,_fetch
  120.                   dc.l     _dup,_number_tib,_store
  121.                   dc.l     _tib,_swap,_move
  122.                   dc.l     _bl,_tib,_number_tib,_fetch
  123.                   dc.l     _1_minus,_plus,_c_store
  124.                   dc.l     _hex,_bl,_word,_number_question
  125.                   dc.l     _question_branch,1$
  126.                   dc.l       _drop,_dp,_8_plus,_store,_branch,2$
  127. 1$                dc.l       _2drop,_to_in,_off
  128. 2$                dc.l     _decimal
  129.                   dc.l     _2,_dp,_8_plus,_fetch,_AllocMem
  130.                   dc.l     _dup,_0_equal,_question_branch,6$
  131.                   dc.l        _nest_lit,300,_nest_bye
  132. 6$                dc.l     _dp,_2dup,_store,_4_plus,_store
  133.                   dc.l     _exit
  134.  
  135.  
  136. * (bye)           (s return code -- )        ;sets d0 to return code
  137.                   dc.w     -1                ; usefull for telling user
  138.                   dc.l     link0             ; which problem occurred.
  139. link0             set      *-4
  140.                   dc.b     $85,'(bye',$80!')'
  141.                   cnop     0,2
  142. _nest_bye         dc.l     *+4
  143.                   move.l   (sp),d0
  144.                   move.l   init_sp,sp
  145.                   addq.l   #8,sp
  146.                   rts
  147.  
  148. * bye             (s -- )  Exits to Amiga dos.
  149. ; Closes the console device, the window, any open files and any
  150. ; any open libraries.
  151.                   dc.w     -1
  152.                   dc.l     link2
  153. link2             set      *-4
  154.                   dc.b     $83,'by',$80!'e'
  155.                   cnop     0,2
  156. _bye              dc.l     nest
  157.                   dc.l     _CloseConsole
  158.                   dc.l     _Window,_fetch,_CloseWindow
  159.                   dc.l     _close_files
  160.                   dc.l     _close_libs
  161.                   dc.l     _dp,_4_plus,_dup,_fetch,_swap,_4_plus,_fetch
  162.                   dc.l     _FreeMem
  163.                   dc.l     _0,_nest_bye
  164.                   dc.l     _exit
  165.  
  166.  
  167. * warm  -  warm start routine, low level
  168.  
  169. warm              lea      _warm,w           ;point to warm routine
  170.                   move.l   (w)+,a0           ;get nest from warm routine
  171.                   jmp      (a0)              ;and jump to nest
  172.  
  173. * cold  -  code cold start routine
  174. ; Sets the stack and the topstack, stores pointer to string from the command
  175. ; line.  Opens exec, sets up registers and jumps to forth's cold routine.
  176.  
  177. cold
  178.                   move.l   sp,d1             ;get stack addr
  179.                   sub.l    4(sp),d1          ;calculate top of stack
  180.                   lea      topstack,a1       ;point to topstack
  181.                   move.l   d1,(a1)           ; and set it
  182.                   move.l   a0,-(sp)          ;save string address
  183.                   move.l   d0,-(sp)          ; and the length
  184.                   lea      init_sp,a0
  185.                   move.l   sp,(a0)           ;and set SP0
  186.  
  187.                   lea      execbase,a0       ;point to execbase
  188.                   move.l   4,(a0)            ; set execbase
  189.  
  190.                   lea      rpstack,rp        ;start the return stack
  191.                   adda.l   #rpstacksize,rp   ; point to the end
  192.                   lea      init_rp,a0        ;
  193.                   move.l   rp,(a0)
  194.  
  195.                   lea      next,a3           ;set up the next address
  196.  
  197.                   lea      _cold,w           ;point to cold start routine
  198.                   move.l   (w)+,a0
  199.                   jmp      (a0)              ;and jump to it
  200.  
  201.  
  202.